home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#27 (Dec 87)
/
Tear off Menus example
/
ls Pascal version
/
TearMenu.main
next >
Wrap
Text File
|
1987-11-19
|
17KB
|
699 lines
PROGRAM TearMenu;
{ Example of tear-off menus}
{ by Daryl Lovato for MacTutor}
{ Inspired by HyperCard}
{global constants}
CONST
AppleMenuID = 1;
FileMenuID = 2;
EditMenuID = 3;
graphicalMenu = 4;
WindResID = 1;
AboutID = 3000;
{global variables}
VAR
myMenus : ARRAY[AppleMenuID..EditMenuID] OF MenuHandle;
Done : Boolean;
RegWDEFWindow : WindowPtr;
GrowArea : rect;
DragArea : rect;
myWindowPeek : WindowPeek;
MyGraphicsMenu : menuhandle;
currentPatWind : WindowPtr;
{ My Window Definition Function }
FUNCTION MyWindowDef (varCode : Integer;
theWindow : WindowPtr;
message : Integer;
param : LongInt) : LongInt;
TYPE
RectPtr = ^Rect;
VAR
aRectPtr : RectPtr;
myWindowPeek : WindowPeek;
PROCEDURE DoDrawMessage (WindToDraw : WindowPtr;
DrawParam : LongInt);
VAR
TitleBarRect : Rect;
CurrentY : Integer;
index : Integer;
GoAwayBox : Rect;
Show : boolean;
WindowRec : WindowPeek;
BEGIN
WindowRec := WindowPeek(WindToDraw);
Show := WindowRec^.visible;
IF Show THEN
BEGIN
TitleBarRect := WindowRec^.strucRgn^^.rgnBBox;
IF DrawParam <> 0 THEN {just toggle goAway box}
BEGIN
WITH TitleBarRect DO
BEGIN
top := top + 3;
left := left + 5;
bottom := top + 8;
right := left + 8;
END;
InsetRect(TitleBarRect, 1, 1);
InvertRect(TitleBarRect);
END
ELSE {we need to draw the window frame}
BEGIN
PenNormal;
FrameRect(TitleBarRect);
TitleBarRect.bottom := TitleBarRect.top + 13;
FrameRect(TitleBarRect);
InsetRect(TitleBarRect, 1, 1); {shrink by 1}
EraseRect(TitleBarRect);
IF WindowRec^.hilited THEN
BEGIN { add hiliting }
FillRect(TitleBarRect, black);
WITH TitleBarRect DO
BEGIN
top := top + 2;
left := left + 4;
bottom := top + 8;
right := left + 8;
END;
PenMode(patXor);
FrameRect(TitleBarRect);
PenNormal;
END;
END;
END;
END;
FUNCTION DoHitMessage (WindToTest : WindowPtr;
theParam : LongInt) : LongInt;
VAR
globalPt : Point;
aRect : Rect;
GoAwayBox : Rect;
tempRect : Rect;
WindowRec : WindowPeek;
BEGIN
globalPt.h := LoWord(theParam);
globalPt.v := HiWord(theParam);
WindowRec := WindowPeek(WindToTest);
aRect := WindowRec^.strucRgn^^.rgnBBox;
aRect.bottom := aRect.top + 12; {create tBar Rect}
tempRect := WindowRec^.strucRgn^^.rgnBBox;
IF PtInRect(globalPt, tempRect) THEN {in structure rgn?}
BEGIN
tempRect := WindowRec^.contRgn^^.rgnBBox;
IF PtInRect(globalPt, tempRect) THEN {if it was in content rgn}
DoHitMessage := wInContent
ELSE IF PtInRect(globalPt, aRect) THEN {in the drag or go-away}
BEGIN
IF WindowRec^.hilited THEN
BEGIN {we need to check the go-away box}
WITH aRect DO
BEGIN
top := top + 2;
left := left + 4;
bottom := top + 8;
right := left + 8;
END;
IF PtInRect(globalPt, aRect) THEN
DoHitMessage := wInGoAway
ELSE
DoHitMessage := wInDrag;
END
ELSE
DoHitMessage := wInDrag;
END
ELSE {it was in our window frame}
DoHitMessage := wNoHit;
END
ELSE {it wasn't in our window at all}
DoHitMessage := wNoHit;
END;
PROCEDURE DoCalcRgnsMessage (WindToCalc : WindowPtr);
VAR
tempRect : Rect;
aWindowPeek : WindowPeek;
aRgn : RgnHandle;
WindowRec : WindowPeek;
BEGIN
tempRect := WindToCalc^.PortRect;
OffsetRect(tempRect, -WindToCalc^.PortBits.Bounds.Left, -WindToCalc^.PortBits.Bounds.Top);
TempRect.top := TempRect.top - 1;
WindowRec := WindowPeek(WindToCalc);
RectRgn(WindowRec^.contRgn, tempRect);
InsetRect(tempRect, -1, -1);
tempRect.top := tempRect.top - 12;
RectRgn(WindowRec^.strucRgn, tempRect);
END;
BEGIN
MyWindowDef := 0;
CASE message OF
wDraw :
DoDrawMessage(theWindow, param);
wHit :
MyWindowDef := DoHitMessage(theWindow, param);
wCalcRgns :
DoCalcRgnsMessage(theWindow);
wNew :
;
wDispose :
;
wGrow :
;
END;
END;
{ function GetItemRect(item : integer) : rect; }
FUNCTION GetItemRect (item : integer) : rect;
VAR
tempRect : Rect;
BEGIN
WITH tempRect DO
BEGIN
top := (((item - 1) DIV 8) * 16) - 1;
bottom := top + 17;
left := (((item - 1) MOD 8) * 16) - 1;
right := left + 17;
END;
GetItemRect := tempRect;
END;
{# procedure DrawPatWindow; #}
PROCEDURE DrawPatWindow;
VAR
i : integer;
currentPat : Pattern;
currRect : Rect;
BEGIN
FOR i := 1 TO 96 DO
BEGIN
currRect := GetItemRect(i);
FrameRect(currRect);
GetIndPattern(currentPat, 100, i);
FillRect(currRect, currentPat);
FrameRect(currRect);
END;
END;
{# function GetMItemRect(whichRect : Integer; myRect : Rect) : Rect; #}
FUNCTION GetMItemRect (whichRect : Integer;
myRect : Rect) : Rect;
VAR
ItemRect : Rect;
BEGIN
ItemRect := GetItemRect(whichRect);
OffSetRect(itemRect, myRect.left, myRect.top);
GetMItemRect := ItemRect;
END;
{# procedure drawItem(myRect : rect; myItem : integer); #}
PROCEDURE drawItem (myRect : rect;
myItem : integer);
VAR
currentPat : pattern;
BEGIN
IF (myItem > 0) AND (myItem < 97) THEN
BEGIN
myRect := GetMItemRect(myItem, myRect);
GetIndPattern(currentPat, 100, myItem);
FillRect(myRect, currentPat);
FrameRect(myRect);
END;
END;
{# procedure clearitem(myRect : Rect; lastCell : integer); #}
PROCEDURE clearitem (myRect : Rect;
lastCell : integer);
BEGIN
DrawItem(myRect, lastCell - 9);
DrawItem(myRect, lastCell - 8);
DrawItem(myRect, lastCell - 7);
DrawItem(myRect, lastCell - 1);
DrawItem(myRect, lastCell);
DrawItem(myRect, lastCell + 1);
DrawItem(myRect, lastCell + 7);
DrawItem(myRect, lastCell + 8);
DrawItem(myRect, lastCell + 9);
END;
{# Menu Definition Routine #}
PROCEDURE MyMenuDef (message : Integer;
theMenu : MenuHandle;
VAR menuRect : Rect;
hitPt : Point;
VAR whichItem : Integer);
PROCEDURE DoDrawMessage (myMenu : MenuHandle;
myRect : Rect);
CONST
MBarHeight = 20;
VAR
whichRect : Integer;
currentPat : Pattern;
currRect : Rect;
BEGIN
FOR whichRect := 1 TO 96 DO
Drawitem(myRect, whichRect);
END;
FUNCTION DoChooseMessage (myMenu : MenuHandle;
myRect : Rect;
myPoint : Point;
oldItem : Integer) : Integer;
VAR
currRect : Rect;
alldone : boolean;
whichRect : Integer;
oldRect : Rect;
mPt : Point;
lastPt : Point;
lastRect : Rect;
menuPt : Point;
tempRect : Rect;
exitrect : rect;
saveClip : RgnHandle;
io : integer;
BEGIN
ClipRect(myRect);
whichRect := 1;
alldone := false;
REPEAT
currRect := GetMItemRect(whichRect, myRect);
IF PtInRect(myPoint, currRect) THEN
alldone := true
ELSE
whichRect := whichRect + 1;
UNTIL ((AllDone) OR (whichRect > 96));
IF AllDone THEN { if we are in a item}
BEGIN
IF (whichRect <> oldItem) THEN
BEGIN
IF (oldItem <> 0) THEN
ClearItem(myRect, oldItem);
InsetRect(currRect, -6, -6);
PenSize(6, 6);
PenPat(white);
FrameRect(currRect);
PenNormal;
InsetRect(currRect, -1, -1);
FrameRect(currRect);
END;
DoChooseMessage := whichRect;
END
ELSE { we are not in a item}
BEGIN
IF oldItem <> 0 THEN { invert the old item}
clearitem(myRect, oldItem);
DoChooseMessage := 0;
PenMode(notPatXOR);
penpat(gray);
exitrect := myrect;
InsetRect(ExitRect, -10, -10);
ExitRect.top := 20;
menuPt.h := myRect.left + ((myRect.right - myRect.left) DIV 2);
menuPt.v := myRect.top + ((myRect.bottom - myRect.top) DIV 2);
SetRect(tempRect, 0, 0, 0, 0);
lastRect := tempRect;
ClipRect(screenbits.bounds);
REPEAT
GetMouse(mPt);
LocalToGlobal(mPt);
IF ((Longint(mpt) <> Longint(lastPt)) AND (NOT PtInRect(mpt, ExitRect)) AND (mPt.v > 20)) THEN
BEGIN
lastPt := mPt;
tempRect := myRect;
OffSetRect(tempRect, mPt.h - menuPt.h, mPt.v - menuPt.v);
IF tempRect.top < 20 THEN
BEGIN
tempRect.top := 20;
tempRect.bottom := 20 + 202;
END;
FrameRect(lastRect);
FrameRect(tempRect);
lastRect := tempRect;
END;
UNTIL (NOT button) OR ptInRect(mPt, exitrect) OR (mPt.v < 21);
FrameRect(lastRect);
PenNormal;
IF (NOT PtInRect(mpt, ExitRect)) AND (mPt.v > 20) THEN
BEGIN
lastrect.top := lastrect.top + 12;
io := PostEvent(12, Longint(lastRect.topleft));
{ this communicates back to the main event}
{ loop that a window was just torn from the}
{ menu. We pass the new topLeft in the message}
END;
END;
END;
PROCEDURE DoSizeMessage (VAR myMenu : MenuHandle);
BEGIN
WITH myMenu^^ DO
BEGIN
menuWidth := 127;
menuHeight := 191;
END;
END;
BEGIN
CASE message OF
mSizeMsg :
DoSizeMessage(theMenu);
mDrawMsg :
DoDrawMessage(theMenu, menuRect);
mChooseMsg :
whichItem := DoChooseMessage(theMenu, menuRect, hitPt, whichItem);
END;
END;
{# ShowAbout procedure #}
PROCEDURE ShowAbout;
VAR
theDlog : DialogPtr;
theItem : Integer;
BEGIN
theDlog := GetNewDialog(AboutID, NIL, Pointer(-1));
ModalDialog(NIL, theItem);
DisposDialog(theDlog);
END;
{# ProcessMenu procedure #}
PROCEDURE ProcessMenu (codeWord : Longint);
TYPE
PatPtr = ^Pattern;
VAR
menuNum : Integer;
itemNum : Integer;
NameHolder : str255;
dummy : Integer;
yuck : boolean;
myPattern : Pattern;
DeskPatternPtr : PatPtr;
savePort, aPort : grafPtr;
theRgn1, theRgn2 : RgnHandle;
BEGIN
IF codeWord <> 0 THEN
BEGIN
menuNum := HiWord(codeWord);
itemNum := LoWord(codeWord);
CASE menuNum OF { the different menus}
AppleMenuID :
IF itemNum < 3 THEN
ShowAbout
ELSE
BEGIN
GetItem(myMenus[AppleMenuID], itemNum, NameHolder);
dummy := OpenDeskAcc(NameHolder);
END;
FileMenuID :
Done := true;
EditMenuID :
yuck := SystemEdit(itemNum - 1);
GraphicalMenu :
IF ItemNum <> 0 THEN
BEGIN
GetIndPattern(myPattern, 100, ItemNum);
SetPort(currentPatWind);
BackPat(myPattern);
EraseRect(currentPatWind^.portRect);
END;
END;
HiliteMenu(0);
END;
END;
{# Deal With Mouse Downs procedure #}
PROCEDURE DealWithMouseDowns (theEvent : EventRecord);
VAR
location : Integer;
windowPointedTo : WindowPtr;
mouseLoc : point;
windowLoc : integer;
VandH : Longint;
Height : Integer;
Width : Integer;
currRect, myRect : Rect;
newcell, LastCell : integer;
thePt, LastPt : Point;
i : integer;
myPattern : Pattern;
BEGIN
mouseLoc := theEvent.where;
windowLoc := FindWindow(mouseLoc, windowPointedTo);
CASE windowLoc OF
inMenuBar :
ProcessMenu(MenuSelect(mouseLoc));
inSysWindow :
SystemClick(theEvent, windowPointedTo);
inContent :
IF windowPointedTo <> FrontWindow THEN
SelectWindow(windowPointedTo)
ELSE
BEGIN
IF RegWDEFWindow = windowPointedTo THEN
BEGIN
SetPort(RegWDEFWindow);
GetMouse(lastPt);
newCell := 0;
lastCell := 0;
myRect := RegWDEFWindow^.portRect;
WHILE waitmouseup DO {track mouse in pattern wind}
BEGIN
GetMouse(thePt);
IF NOT PtInRect(thePt, myRect) THEN
BEGIN {we moved outside the window}
IF lastCell <> 0 THEN
clearItem(myRect, lastCell);
lastCell := 0;
END
ELSE
BEGIN
FOR i := 1 TO 96 DO
IF PtInRect(thePt, GetItemRect(i)) THEN
newCell := i;
IF newCell <> lastCell THEN
BEGIN
IF (lastCell <> 0) THEN
Clearitem(myRect, lastCell);
currRect := GetItemRect(newCell);
InsetRect(currRect, -6, -6);
PenSize(6, 6);
PenPat(white);
FrameRect(currRect);
PenNormal;
InsetRect(currRect, -1, -1);
FrameRect(currRect);
lastCell := newCell;
END;
END;
END;
Clearitem(myRect, lastCell);
GetIndPattern(myPattern, 100, newCell);
SetPort(currentPatWind);
BackPat(myPattern);
EraseRect(currentPatWind^.portRect);
END;
END;
inDrag :
BEGIN
DragWindow(windowPointedTo, mouseLoc, DragArea);
SelectWindow(windowPointedTo);
END;
inGoAway :
IF TrackGoAway(windowPointedTo, mouseLoc) THEN
HideWindow(windowPointedTo);
END;
END;
{# Deal With Key Downs procedure #}
PROCEDURE DealWithKeyDowns (theEvent : EventRecord);
TYPE
Trick = PACKED RECORD
CASE boolean OF
true : (
long : Longint
);
false : (
chr3, chr2, chr1, chr0 : char
)
END;
VAR
CharCode : char;
TrickVar : Trick;
BEGIN
TrickVar.long := theEvent.message;
CharCode := TrickVar.chr0;
IF BitAnd(theEvent.modifiers, CmdKey) = CmdKey THEN {check for a menu selection}
ProcessMenu(MenuKey(CharCode))
END;
{# Deal With Updates procedure #}
PROCEDURE DealWithUpdates (theEvent : EventRecord);
VAR
UpDateWindow : WindowPtr;
tempPort : WindowPtr;
BEGIN
UpDateWindow := WindowPtr(theEvent.message);
GetPort(tempPort);
SetPort(UpDateWindow);
BeginUpDate(UpDateWindow);
EraseRect(UpDateWindow^.portRect);
IF UpdateWindow <> currentPatWind THEN
DrawPatWindow;
EndUpDate(UpDateWindow);
SetPort(tempPort);
END;
{# MainEventLoop procedure #}
PROCEDURE MainEventLoop;
VAR
Event : EventRecord;
ProcessIt : boolean;
where : Point;
BEGIN
REPEAT
SystemTask;
IF GetNextEvent(everyEvent, Event) THEN
CASE Event.what OF
mouseDown :
DealWithMouseDowns(Event);
AutoKey :
DealWithKeyDowns(Event);
KeyDown :
DealWithKeyDowns(Event);
UpdateEvt :
DealWithUpdates(Event);
12 :
BEGIN { we return this when a window has been torn}
where := Point(Event.message);
HideWindow(RegWDefWindow);
MoveWindow(RegWDefWindow, where.h, where.v, true);
ShowWindow(RegWDEFWindow);
END;
OTHERWISE
BEGIN
END;
END; {of case}
UNTIL Done;
END;
{# SetupMemory procedure #}
PROCEDURE SetupMemory;
VAR
x : Longint;
BEGIN
{x := ORD4(ApplicZone) + 128000;}
{SetApplLimit(Pointer(x));}
MaxApplZone;
MoreMasters;
MoreMasters;
MoreMasters;
END;
{# SetupLimits #}
PROCEDURE SetupLimits;
VAR
Screen : Rect;
BEGIN
Screen := ScreenBits.bounds;
WITH Screen DO
BEGIN
SetRect(DragArea, left + 4, top + 24, right - 4, bottom - 4);
SetRect(GrowArea, left, top + 24, right, bottom);
END;
END;
{# MakeMenus procedure #}
PROCEDURE MakeMenus;
VAR
index : Integer;
BEGIN
FOR index := AppleMenuID TO EditMenuID DO
BEGIN
myMenus[index] := GetMenu(index);
InsertMenu(myMenus[index], 0);
END;
AddResMenu(myMenus[AppleMenuID], 'DRVR');
MyGraphicsMenu := NewMenu(4, 'Graphics');
MyGraphicsMenu^^.menuProc := NewHandle(0);
MyGraphicsMenu^^.menuProc^ := Ptr(@MyMenuDef);
CalcMenuSize(MyGraphicsMenu);
Insertmenu(MyGraphicsMenu, 0);
DrawMenuBar;
END;
PROCEDURE crash;
BEGIN
ExitToShell;
END;
{# Program Excecution Starts Here #}
BEGIN
InitGraf(@thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(@crash);
InitCursor;
Done := false;
FlushEvents(everyEvent, 0);
SetupLimits;
SetupMemory;
MakeMenus;
RegWDEFWindow := GetNewWindow(WindResID, NIL, Pointer(-1));
myWindowPeek := WindowPeek(RegWDEFWindow);
myWindowPeek^.windowDefProc := NewHandle(0);
myWindowPeek^.windowDefProc^ := Ptr(@MyWindowDef);
SetWRefCon(RegWDEFWIndow, Ord4(MyGraphicsMenu));
currentPatWind := GetNewWindow(2, NIL, pointer(-1));
SetPort(currentPatWind);
BackPat(gray);
EraseRect(currentPatWind^.portRect);
MainEventLoop;
END. {thats all folkes!}
